COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(FILECREATED "20-Feb-82 19:42:04" <DDYER>IPOLY..13 6186   
C00012 ENDMK
C⊗;
(FILECREATED "20-Feb-82 19:42:04" <DDYER>IPOLY..13 6186   

     previous date: "20-Feb-82 19:36:45" <DDYER>IPOLY..11)


(PRETTYCOMPRINT IPOLYCOMS)

(RPAQQ IPOLYCOMS ((DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
			    (P (SPECVARS ANS COEF F INC I K QQ SS V *X* *ALPHA *A* *B* *CHK *L *P Q* 
					 U* *VAR *Y* R R2 R3 START RES1 RES2 RES3)))
	(FNS PCOEFADD PCPLUS PCPLUS1 PPLUS PTIMES PTIMES1 PTIMES2 PTIMES3 PSIMP PCTIMES PCTIMES1 
	     PEXPTSQ PPLUS1 BENCH ODDP SETUP)
	(MACROS * IPOLYMACROS)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY 
(SPECVARS ANS COEF F INC I K QQ SS V *X* *ALPHA *A* *B* *CHK *L *P Q* U* *VAR *Y* R R2 R3 START RES1 
	  RES2 RES3)
)
(DEFINEQ

(PCOEFADD
  [LAMBDA (E C X)
    (COND
      ((PZEROP C)
	X)
      (T (CONS E (CONS C X])

(PCPLUS
  [LAMBDA (C P)
    (COND
      ((PCOEFP P)
	(CPLUS P C))
      (T (PSIMP (CAR P)
		(PCPLUS1 C (CDR P])

(PCPLUS1
  [LAMBDA (C X)
    (COND
      [(NULL X)
	(COND
	  ((PZEROP C)
	    NIL)
	  (T (CONS 0 (CONS C NIL]
      ((PZEROP (CAR X))
	(PCOEFADD 0 (PPLUS C (CADR X))
		  NIL))
      (T (CONS (CAR X)
	       (CONS (CADR X)
		     (PCPLUS1 C (CDDR X])

(PPLUS
  [LAMBDA (X Y)
    (COND
      ((PCOEFP X)
	(PCPLUS X Y))
      ((PCOEFP Y)
	(PCPLUS Y X))
      [(EQ (CAR X)
	   (CAR Y))
	(PSIMP (CAR X)
	       (PPLUS1 (CDR Y)
		       (CDR X]
      [(POINTERGP (CAR X)
		  (CAR Y))
	(PSIMP (CAR X)
	       (PCPLUS1 Y (CDR X]
      (T (PSIMP (CAR Y)
		(PCPLUS1 X (CDR Y])

(PTIMES
  [LAMBDA (X Y)
    (COND
      ((OR (PZEROP X)
	   (PZEROP Y))
	(PZERO))
      ((PCOEFP X)
	(PCTIMES X Y))
      ((PCOEFP Y)
	(PCTIMES Y X))
      [(EQ (CAR X)
	   (CAR Y))
	(PSIMP (CAR X)
	       (PTIMES1 (CDR X)
			(CDR Y]
      [(POINTERGP (CAR X)
		  (CAR Y))
	(PSIMP (CAR X)
	       (PCTIMES1 Y (CDR X]
      (T (PSIMP (CAR Y)
		(PCTIMES1 X (CDR Y])

(PTIMES1
  [LAMBDA (*X* Y)
    (PROG (U* V)
          (SETQ V (SETQ U*(PTIMES2 Y)))
      A   (SETQ *X*(CDDR *X*))
          (COND
	    ((NULL *X*)
	      (RETURN U*)))
          (PTIMES3 Y)
          (GO A])

(PTIMES2
  [LAMBDA (Y)
    (COND
      ((NULL Y)
	NIL)
      (T (PCOEFADD (PLUS (CAR *X*)
			 (CAR Y))
		   (PTIMES (CADR *X*)
			   (CADR Y))
		   (PTIMES2 (CDDR Y])

(PTIMES3
  [LAMBDA (Y)
    (PROG (E U C)
      A1  (COND
	    ((NULL Y)
	      (RETURN NIL)))
          (SETQ E (IPLUS (CAR *X*)
			 (CAR Y)))
          (SETQ C (PTIMES (CADR Y)
			  (CADR *X*)))
          (COND
	    ((PZEROP C)
	      (SETQ Y (CDDR Y))
	      (GO A1))
	    ((OR (NULL V)
		 (IGREATERP E (CAR V)))
	      [SETQ U*(SETQ V (PPLUS1 U*(LIST E C]
	      (SETQ Y (CDDR Y))
	      (GO A1))
	    ((IEQP E (CAR V))
	      (SETQ C (PPLUS C (CADR V)))
	      (COND
		[(PZEROP C)
		  (SETQ U*(SETQ V (PDIFFER1 U*(LIST (CAR V)
						    (CADR V]
		(T (RPLACA (CDR V)
			   C)))
	      (SETQ Y (CDDR Y))
	      (GO A1)))
      A   (COND
	    ((AND (CDDR V)
		  (IGREATERP (CADDR V)
			     E))
	      (SETQ V (CDDR V))
	      (GO A)))
          (SETQ U (CDR V))
      B   (COND
	    ((OR (NULL (CDR U))
		 (ILESSP (CADR U)
			 E))
	      [RPLACD U (CONS E (CONS C (CDR U]
	      (GO E)))
          (COND
	    ((PZEROP (SETQ C (PPLUS (CADDR U)
				    C)))
	      (RPLACD U (CDDDR U))
	      (GO D))
	    (T (RPLACA (CDDR U)
		       C)))
      E   (SETQ U (CDDR U))
      D   (SETQ Y (CDDR Y))
          (COND
	    ((NULL Y)
	      (RETURN NIL)))
          (SETQ E (IPLUS (CAR *X*)
			 (CAR Y)))
          (SETQ C (PTIMES (CADR Y)
			  (CADR *X*)))
      C   (COND
	    ((AND (CDR U)
		  (IGREATERP (CADR U)
			     E))
	      (SETQ U (CDDR U))
	      (GO C)))
          (GO B])

(PSIMP
  [LAMBDA (VAR X)
    (COND
      ((NULL X)
	0)
      ((ATOM X)
	X)
      ((ZEROP (CAR X))
	(CADR X))
      (T (CONS VAR X])

(PCTIMES
  [LAMBDA (C P)
    (COND
      ((PCOEFP P)
	(CTIMES C P))
      (T (PSIMP (CAR P)
		(PCTIMES1 C (CDR P])

(PCTIMES1
  [LAMBDA (C X)
    (COND
      ((NULL X)
	NIL)
      (T (PCOEFADD (CAR X)
		   (PTIMES C (CADR X))
		   (PCTIMES1 C (CDDR X])

(PEXPTSQ
  [LAMBDA (P N)
    (PROG (S)
          (SETQ S (COND
	      ((ODDP N)
		P)
	      (T 1)))
          (SETQ N (QUOTIENT N 2))
      LOOP(COND
	    ((ZEROP N)
	      (RETURN S)))
          (SETQ P (PTIMES P P))
          (AND (ODDP N)
	       (SETQ S (PTIMES S P)))
          (SETQ N (QUOTIENT N 2))
          (GO LOOP])

(PPLUS1
  [LAMBDA (X Y)
    (COND
      ((NULL X)
	Y)
      ((NULL Y)
	X)
      [(IEQP (CAR X)
	     (CAR Y))
	(PCOEFADD (CAR X)
		  (PPLUS (CADR X)
			 (CADR Y))
		  (PPLUS1 (CDDR X)
			  (CDDR Y]
      [(IGREATERP (CAR X)
		  (CAR Y))
	(CONS (CAR X)
	      (CONS (CADR X)
		    (PPLUS1 (CDDR X)
			    Y]
      (T (CONS (CAR Y)
	       (CONS (CADR Y)
		     (PPLUS1 X (CDDR Y])

(BENCH
  [LAMBDA (N)
    (TIME (PEXPTSQ R N)
	  1 3])

(ODDP
  [LAMBDA (X)
    (EQP (REMAINDER X 2)
	 1])

(SETUP
  [LAMBDA NIL
    (PUTPROP (QUOTE X)
	     (QUOTE ORDER)
	     1)
    (PUTPROP (QUOTE Y)
	     (QUOTE ORDER)
	     2)
    (PUTPROP (QUOTE Z)
	     (QUOTE ORDER)
	     3)
    [SETQ R (PPLUS (QUOTE (X 1 1 0 1))
		   (PPLUS (QUOTE (Y 1 1))
			  (QUOTE (Z 1 1]
    (SETQ R2 (PTIMES R 100000))
    (SETQ R3 (PTIMES R 1.0])
)

(RPAQQ IPOLYMACROS (CPLUS CTIMES PCOEFP POINTERGP PZERO PZEROP))
(DECLARE: EVAL@COMPILE 

(PUTPROPS CPLUS MACRO [LAMBDA (X Y)
			(PLUS X Y])

(PUTPROPS CTIMES MACRO [LAMBDA (X Y)
			 (TIMES X Y])

(PUTPROPS PCOEFP MACRO [LAMBDA (E)
			 (ATOM E])

(PUTPROPS POINTERGP MACRO [LAMBDA (X Y)
			    (IGREATERP (GETPROP X (QUOTE ORDER))
				       (GETPROP Y (QUOTE ORDER])

(PUTPROPS PZERO MACRO [LAMBDA NIL 0])

(PUTPROPS PZEROP MACRO [LAMBDA (X)
			 (EQP X 0])
)
STOP